home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / w_XmString.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  30.4 KB  |  826 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         w_XmString.c
  5. * RCS:          $Header: w_XmString.c,v 1.6 91/03/14 03:13:22 mayer Exp $
  6. * Description:  Interfaces to XmString routines
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Sun Nov  5 14:46:20 1989
  9. * Modified:     Thu Oct  3 23:40:04 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: w_XmString.c,v 1.6 91/03/14 03:13:22 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <Xm/Xm.h>
  46. #include "winterp.h"
  47. #include "user_prefs.h"
  48. #include "xlisp/xlisp.h"
  49. #include "w_XmString.h"
  50.  
  51. static LVAL s_XmSTRING_DIRECTION_L_TO_R, s_XmSTRING_DIRECTION_R_TO_L; /* init'd in Wxms_Init() */
  52.  
  53. /******************************************************************************
  54.  *
  55.  ******************************************************************************/
  56. void Wxms_Garbage_Collect_XmString(lval_xmstring)
  57.      LVAL lval_xmstring;
  58. {
  59.   XmStringFree(get_xmstring(lval_xmstring));
  60. }
  61.  
  62.  
  63. /******************************************************************************
  64.  * the XmStrings created here will be freed when the lisp vector holding
  65.  * the XmStrings gets garbage collected and  there are no more references
  66.  * to the XmStrings.
  67.  ******************************************************************************/
  68. LVAL Wxms_XmStringTable_To_Lisp_Vector(xmstrtab, size)
  69.      XmStringTable xmstrtab;
  70.      int           size;
  71. {
  72.   LVAL result;
  73.   int i;
  74.   
  75.   if (!xmstrtab || !size)
  76.     return (NIL);
  77.  
  78.   xlsave1(result);
  79.   result = newvector(size);
  80.   for (i = 0; i < size; i++)
  81.     setelement(result, i, cv_xmstring(XmStringCopy(xmstrtab[i])));
  82.   xlpop();
  83.   return (result);
  84. }
  85.  
  86.  
  87. /******************************************************************************
  88.  * This is equivalent to an xlga*() function, in that it retrieves an argument
  89.  * of a certain type from the argument stack. This particular xlga*() function
  90.  * will retrieve a String OR XmString argument to an XLISP function. If the
  91.  * argument was a string, it will convert it to an XmString and return that,
  92.  * otherwise it returns the XmString-value of the argument.
  93.  *
  94.  * In calling this function, you must pass it a pointer to an LVAL in which
  95.  * this function will store a lisp-node of type XLTYPE_XmString. If this 
  96.  * function ended up converting a string to an XmString, that XmString will be
  97.  * garbage collected unless it is explicitly saved by code in the calling function.
  98.  * In many cases, this fn. is used in methods that return the XLTYPE_XmString
  99.  * node, in which case the XLTYPE_XmString won't be garbage collected if it
  100.  * is referenced in the user's lisp code.
  101.  ******************************************************************************/
  102. XmString Get_String_or_XmString_Arg_Returning_XmString(item)
  103.      LVAL *item;        /* param to return an LVAL_XmString */
  104. {
  105.   XmString result;
  106.   LVAL arg = xlgetarg();
  107.  
  108.   if (xmstring_p(arg)) {
  109.     *item = arg;
  110.     return (get_xmstring(arg));
  111.   }
  112.   else if (stringp(arg)) {
  113.     result = XmStringCreate(getstring(arg), XmSTRING_DEFAULT_CHARSET);
  114.     *item = cv_xmstring(result); /* note that the XmString created  will get g.c'd if not ref'd */
  115.     return (result);
  116.   }
  117.   else
  118.     xlerror("Bad type: expected either a XmString or a string.", arg);
  119. }
  120.  
  121.  
  122. /******************************************************************************
  123.  * Wxms_Cvt_LispStringSequence_to_SuperXmStringTable() converts it's LVAL argument
  124.  * and returns a SuperXmStringTable. The LVAL is a sequence (list or array) of
  125.  * String(s) OR XmString(s).
  126.  * If the sequence element was a string, this routine will automatically convert it
  127.  * to an XmString. Thus this routine will return a SuperXmStringTable object, which
  128.  * contains the XmStringTable representing the LVAL.
  129.  *
  130.  * You MUST call Wxms_Free_SuperXmStringTable() after calling this function and after
  131.  * the SuperXmStringTable result of this function is no longer being used.
  132.  * The cleanup function will deallocate any automatically converted XmStrings.
  133.  ******************************************************************************/
  134.  
  135. #define XMSTRINGTABLE_SIZE_INCREMENT 50
  136. #define FREEABLES_SIZE_INCREMENT 50
  137.  
  138. static SuperXmStringTable New_SuperXmStringTable(size)
  139.      int size;
  140. {
  141.   SuperXmStringTable superstrtab = (SuperXmStringTable) XtMalloc((unsigned) sizeof(struct _SuperXmStringTable));
  142.   superstrtab->xmstrtab = (XmString *) XtMalloc((unsigned) (size * sizeof(XmString)));
  143.   superstrtab->freeables = NULL;
  144.   return (superstrtab);
  145. }
  146.  
  147. void Wxms_Free_SuperXmStringTable(superstrtab)
  148.      SuperXmStringTable superstrtab;
  149. {
  150.   /*
  151.    * deallocate stuff declared as freeable by SuperXmStringTable_Declare_Temporary_Storage()
  152.    */
  153.   register int i, freeables_end_idx;
  154.   Deallocator_Pair* freeables;
  155.  
  156.   if (superstrtab->freeables) {
  157.     freeables = superstrtab->freeables;
  158.     freeables_end_idx = superstrtab->freeables_end_idx;
  159.     for (i = 0 ; i < freeables_end_idx ; i++)
  160.       (*(freeables[i].deallocator))(freeables[i].pointer);
  161.     XtFree(superstrtab->freeables);
  162.   }
  163.  
  164.   /*
  165.    * Free the XmStringTable
  166.    */
  167.   if (superstrtab->xmstrtab)
  168.     XtFree(superstrtab->xmstrtab);
  169.  
  170.   XtFree(superstrtab);
  171. }
  172.  
  173. static void SuperXmStringTable_Declare_Temporary_Storage(superstrtab, pointer, deallocator)
  174.      SuperXmStringTable superstrtab;
  175.      XtPointer          pointer;
  176.      void             (*deallocator)();
  177. {
  178.   if (superstrtab->freeables == NULL) {
  179.     superstrtab->freeables_size = FREEABLES_SIZE_INCREMENT;
  180.     superstrtab->freeables = (Deallocator_Pair *) XtMalloc((unsigned) (superstrtab->freeables_size * sizeof(struct _Deallocator_Pair)));
  181.     superstrtab->freeables_end_idx = 0;
  182.   }
  183.   else if (superstrtab->freeables_end_idx >= superstrtab->freeables_size) {
  184.     superstrtab->freeables_size += FREEABLES_SIZE_INCREMENT;
  185.     superstrtab->freeables = (Deallocator_Pair *) XtRealloc(superstrtab->freeables, (unsigned) (superstrtab->freeables_size * sizeof(struct _Deallocator_Pair)));
  186.   }
  187.  
  188.   superstrtab->freeables[superstrtab->freeables_end_idx].pointer = pointer;
  189.   superstrtab->freeables[superstrtab->freeables_end_idx].deallocator = deallocator;
  190.   ++(superstrtab->freeables_end_idx);
  191. }
  192.  
  193. SuperXmStringTable Wxms_Cvt_LispStringSequence_to_SuperXmStringTable(lisp_val)
  194.      LVAL lisp_val;
  195. {
  196.   LVAL elt;
  197.   SuperXmStringTable superstrtab;
  198.   XmString* xmstrtab;
  199.   register int xmstrtab_end_idx;
  200.   int xmstrtab_size;
  201.  
  202.   /*
  203.    * if argument is a vector, then step through array building C XmString Table.
  204.    */
  205.   if (vectorp(lisp_val)) {
  206.     xmstrtab_size = getsize(lisp_val);
  207.     superstrtab = New_SuperXmStringTable(xmstrtab_size);
  208.     xmstrtab = superstrtab->xmstrtab;
  209.     
  210.     for (xmstrtab_end_idx = 0; xmstrtab_end_idx < xmstrtab_size; xmstrtab_end_idx++) {
  211.       elt = getelement(lisp_val, xmstrtab_end_idx);
  212.       if stringp(elt)
  213.     SuperXmStringTable_Declare_Temporary_Storage(superstrtab,
  214.        (XtPointer) (xmstrtab[xmstrtab_end_idx] = XmStringCreate((char*) getstring(elt), XmSTRING_DEFAULT_CHARSET)),
  215.            XmStringFree);
  216.       else if xmstring_p(elt)
  217.     xmstrtab[xmstrtab_end_idx] = get_xmstring(elt);    /* note -- this XmString will get freed by garbage collection */
  218.       else {
  219.     Wxms_Free_SuperXmStringTable(superstrtab);    
  220.     xlerror("Bad XmStringTable element -- expected a String or an XmString.", elt);
  221.       }
  222.     }
  223.     superstrtab->xmstrtab_end_idx = xmstrtab_end_idx;
  224.     return (superstrtab);
  225.   }
  226.   /*
  227.    * if argument is a list, then cdr through list building C XmString Table.
  228.    */
  229.   else if (consp(lisp_val)) {
  230.     xmstrtab_size = XMSTRINGTABLE_SIZE_INCREMENT;
  231.     superstrtab = New_SuperXmStringTable(xmstrtab_size);
  232.     xmstrtab = superstrtab->xmstrtab;
  233.  
  234.     for (xmstrtab_end_idx = 0 ; (consp(lisp_val)) ; lisp_val = cdr(lisp_val), xmstrtab_end_idx++) {
  235.       if (xmstrtab_end_idx >= xmstrtab_size) { /* make sure it'll fit into allocated xmstrtab */
  236.     xmstrtab_size += XMSTRINGTABLE_SIZE_INCREMENT;
  237.     superstrtab->xmstrtab = xmstrtab = (XmString *) XtRealloc(xmstrtab, (unsigned) (xmstrtab_size * sizeof(XmString)));
  238.       }
  239.       elt = car(lisp_val);
  240.       if (stringp(elt))
  241.     SuperXmStringTable_Declare_Temporary_Storage(superstrtab,
  242.        (XtPointer) (xmstrtab[xmstrtab_end_idx] = XmStringCreate((char*) getstring(elt), XmSTRING_DEFAULT_CHARSET)),
  243.            XmStringFree);
  244.       else if (xmstring_p(elt))
  245.     xmstrtab[xmstrtab_end_idx] = get_xmstring(elt);    /* note -- this XmString will get freed by garbage collection */
  246.       else {
  247.     Wxms_Free_SuperXmStringTable(superstrtab);
  248.     xlerror("Bad XmStringTable element -- expected a String or an XmString.", elt);
  249.       }
  250.     }
  251.     if (lisp_val) {        /* if loop terminated due to list pointer not being a CONS cell */
  252.       Wxms_Free_SuperXmStringTable(superstrtab);    
  253.       xlerror("Bad XmStringTable list element -- expected a list of Strings or XmStrings.", lisp_val);
  254.     }
  255.     superstrtab->xmstrtab_end_idx = xmstrtab_end_idx;
  256.     return (superstrtab);
  257.   }
  258.   /*
  259.    * if argument wasn't list or vector, then error
  260.    */
  261.   else
  262.     xlerror("Bad argument type. Expected a list or vector of strings or XmStrings", lisp_val);
  263. }
  264.  
  265.  
  266. /******************************************************************************
  267.  * (XM_STRING_CREATE <string> [<charset>])
  268.  *    --> returns an XMSTRING version of string <string>.
  269.  * 
  270.  * Create a compound string from STRING <text>. Optional argument <charset>
  271.  * is a STRING specifying an XmStringCharSet. If the <charset> argument is
  272.  * ommitted, XmSTRING_DEFAULT_CHARSET is used.
  273.  *
  274.  * XmString XmStringCreate (text, charset)
  275.  *     char    *text;
  276.  *     XmStringCharSet charset;
  277.  ******************************************************************************/
  278. LVAL Wxms_Prim_XM_STRING_CREATE()
  279. {
  280.   char* string;
  281.   XmStringCharSet charset;
  282.  
  283.   string = (char*) getstring(xlgastring());
  284.   if (moreargs())
  285.     charset = (XmStringCharSet) getstring(xlgastring());
  286.   else
  287.     charset = (XmStringCharSet) XmSTRING_DEFAULT_CHARSET;
  288.   xllastarg();
  289.   
  290.   return (cv_xmstring(XmStringCreate(string, charset)));
  291. }
  292.  
  293.  
  294. /******************************************************************************
  295.  * (XM_STRING_DIRECTION_CREATE :STRING_DIRECTION_L_TO_R)
  296.  *    --> returns an XMSTRING with a single L->R direction component.
  297.  * (XM_STRING_DIRECTION_CREATE :STRING_DIRECTION_R_TO_L)
  298.  *    --> returns an XMSTRING with a single R->L direction component
  299.  *
  300.  *
  301.  * XmString XmStringDirectionCreate (direction)
  302.  *     XmStringDirection direction;
  303.  ******************************************************************************/
  304. LVAL Wxms_Prim_XM_STRING_DIRECTION_CREATE()
  305. {
  306.   LVAL direction = xlgetarg();
  307.   xllastarg();
  308.   
  309.   if (direction == s_XmSTRING_DIRECTION_L_TO_R)
  310.     return (cv_xmstring(XmStringDirectionCreate(XmSTRING_DIRECTION_L_TO_R)));
  311.   else if (direction == s_XmSTRING_DIRECTION_R_TO_L)
  312.     return (cv_xmstring(XmStringDirectionCreate(XmSTRING_DIRECTION_R_TO_L)));
  313.   else
  314.     xlerror("Bad <direction> keyword.", direction);
  315. }
  316.  
  317.  
  318. /******************************************************************************
  319.  * (XM_STRING_SEPARATOR_CREATE)
  320.  *    --> returns an XMSTRING with a single component, a separator.
  321.  *
  322.  * XmString XmStringSeparatorCreate ()
  323.  ******************************************************************************/
  324. LVAL Wxms_Prim_XM_STRING_SEPARATOR_CREATE()
  325. {
  326.   xllastarg();
  327.   return (cv_xmstring(XmStringSeparatorCreate()));
  328. }
  329.  
  330.  
  331. /******************************************************************************
  332.  * (XM_STRING_SEGMENT_CREATE <text> [<charset>] <direction> <separator_p>)
  333.  *    --> returns a XMSTRING of the specified 
  334.  * string <text>, 
  335.  * optional string specifying character set <charset>, 
  336.  * symbol <direction>, either :STRING_DIRECTION_L_TO_R, or
  337.  *                            :STRING_DIRECTION_R_TO_L
  338.  * if <separator_p> is not NIL, a separator component will be included.
  339.  * 
  340.  
  341.  * XmString XmStringSegmentCreate (text, charset, direction, separator)
  342.  *     char          *text;
  343.  *     XmStringCharSet     charset;
  344.  *     XmStringDirection direction;
  345.  *     Boolean         separator;
  346.  ******************************************************************************/
  347. LVAL Wxms_Prim_XM_STRING_SEGMENT_CREATE()
  348. {
  349.   XmStringDirection direction;
  350.   char* text;
  351.   LVAL lval_direction, separator_p, lval_charset;
  352.   XmStringCharSet charset;
  353.  
  354.   text = (char*) getstring(xlgastring());
  355.   lval_charset = xlgetarg();
  356.   if (stringp(lval_charset)) {
  357.     charset = (XmStringCharSet) getstring(lval_charset);
  358.     lval_direction = xlgetarg();
  359.   }
  360.   else {
  361.     charset = (XmStringCharSet) XmSTRING_DEFAULT_CHARSET;
  362.     lval_direction = lval_charset;
  363.   }
  364.   separator_p = xlgetarg();
  365.   xllastarg();
  366.  
  367.   if (lval_direction == s_XmSTRING_DIRECTION_L_TO_R)
  368.     direction = XmSTRING_DIRECTION_L_TO_R;
  369.   else if (lval_direction == s_XmSTRING_DIRECTION_R_TO_L)
  370.     direction = XmSTRING_DIRECTION_R_TO_L;
  371.   else
  372.     xlerror("Bad <direction> keyword.", lval_direction);
  373.   
  374.   return (cv_xmstring(XmStringSegmentCreate(text, charset, direction, 
  375.                         (separator_p) ? TRUE : FALSE)));
  376. }
  377.  
  378. /******************************************************************************
  379.  * (XM_STRING_CREATE_L_TO_R <text> [<charset>])
  380.  *    --> returns an XMSTRING version of string <text>.
  381.  * 
  382.  * Create a left-to-right compound string from STRING <text>. If <text>
  383.  * includes '\n', they will be replaced by a separator.
  384.  *
  385.  * Optional argument <charset> is a STRING specifying an XmStringCharSet. If the
  386.  * <charset> argument is ommitted, XmSTRING_DEFAULT_CHARSET is used.
  387.  *
  388.  * XmString XmStringCreateLtoR (text, charset)
  389.  *     char    *text;
  390.  *     XmStringCharSet charset;
  391.  ******************************************************************************/
  392. LVAL Wxms_Prim_XM_STRING_CREATE_L_TO_R()
  393. {
  394.   char* string;
  395.   XmStringCharSet charset;
  396.  
  397.   string = (char*) getstring(xlgastring());
  398.   if (moreargs())
  399.     charset = (XmStringCharSet) getstring(xlgastring());
  400.   else
  401.     charset = (XmStringCharSet) XmSTRING_DEFAULT_CHARSET;
  402.   xllastarg();
  403.   
  404.   return (cv_xmstring(XmStringCreateLtoR(string, charset)));
  405. }
  406.  
  407.  
  408. /******************************************************************************
  409.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  410.  * 
  411.  * Boolean XmStringInitContext (context, string)
  412.  *     XmStringContext *context;
  413.  *     XmString string;
  414.  ******************************************************************************/
  415. /******************************************************************************
  416.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  417.  *
  418.  * void XmStringFreeContext (context)
  419.  *     XmStringContext context;
  420.  ******************************************************************************/
  421. /******************************************************************************
  422.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  423.  *
  424.  * XmStringComponentType 
  425.  * XmStringGetNextComponent (context, text, charset, direction, 
  426.  *         unknown_tag, unknown_length, unknown_value)
  427.  *     XmStringContext     context;
  428.  *     char        **text;
  429.  *     XmStringCharSet    *charset;
  430.  *     XmStringDirection    *direction;
  431.  *     XmStringComponentType *unknown_tag;
  432.  *     UShort        *unknown_length;
  433.  *     UChar        **unknown_value;
  434.  ******************************************************************************/
  435. /******************************************************************************
  436.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  437.  *
  438.  * XmStringComponentType XmStringPeekNextComponent (context)
  439.  *     XmStringContext    context;
  440.  ******************************************************************************/
  441. /******************************************************************************
  442.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  443.  *
  444.  * Boolean XmStringGetNextSegment (context, text, charset, direction, separator)
  445.  *     XmStringContext     context;
  446.  *     char        **text;
  447.  *     XmStringCharSet    *charset;
  448.  *     XmStringDirection *direction;
  449.  *     Boolean        *separator;
  450.  ******************************************************************************/
  451.  
  452.  
  453. /******************************************************************************
  454.  * (XM_STRING_GET_L_TO_R <xmstring> [<charset>])
  455.  *    --> returns a STRING, or NIL if no matching character set found.
  456.  *
  457.  * This function will fetch the first text segment of the XMSTRING <xmstring>
  458.  * which matches the character set <charset>, and returns that as a STRING.
  459.  * Optional argument <charset> is a STRING specifying an XmStringCharSet.
  460.  * If the <charset> argument is ommitted, XmSTRING_DEFAULT_CHARSET is used.
  461.  *
  462.  * Boolean XmStringGetLtoR (string, charset, text)
  463.  *     XmString         string;
  464.  *     XmStringCharSet    charset;
  465.  *     char        **text;
  466.  ******************************************************************************/
  467. LVAL Wxms_Prim_XM_STRING_GET_L_TO_R()
  468. {
  469.   LVAL lval_string;
  470.   char* result;
  471.   XmStringCharSet charset;
  472.   XmString xmstring;
  473.  
  474.   xmstring = get_xmstring(xlga_xmstring());
  475.   if (moreargs())
  476.     charset = (XmStringCharSet) getstring(xlgastring());
  477.   else
  478.     charset = (XmStringCharSet) XmSTRING_DEFAULT_CHARSET;
  479.   xllastarg();
  480.  
  481.   if (XmStringGetLtoR(xmstring, charset, &result)) {
  482. /*    
  483.     lval_string = cvstring(result);
  484.     XtFree(result);
  485. */
  486.     lval_string = cv_string(result); /* don't copy string, let XLISP-GC free it... */
  487.     return (lval_string);
  488.   }
  489.   else 
  490.     return (NIL);
  491. }
  492.  
  493.  
  494. /******************************************************************************
  495.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  496.  *
  497.  * XmFontList XmFontListCreate (font, charset)
  498.  *     XFontStruct     *font;
  499.  *     XmStringCharSet     charset;
  500.  ******************************************************************************/
  501. /******************************************************************************
  502.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  503.  *
  504.  * XmFontList XmStringCreateFontList (font, charset)
  505.  *     XFontStruct     *font;
  506.  *     XmStringCharSet     charset;
  507.  ******************************************************************************/
  508. /******************************************************************************
  509.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  510.  *
  511.  * void  XmFontListFree (fontlist)
  512.  *     XmFontList fontlist;
  513.  ******************************************************************************/
  514. /******************************************************************************
  515.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  516.  *
  517.  * XmFontList XmFontListAdd (old, font, charset)
  518.  *     XmFontList     old;
  519.  *     XFontStruct        *font;
  520.  *     XmStringCharSet    charset;
  521.  ******************************************************************************/
  522. /******************************************************************************
  523.  * XmStrings are gross! -- I'm ignoring this fn in this version of WINTERP.
  524.  *
  525.  * XmFontList XmFontListCopy (fontlist)
  526.  *     XmFontList fontlist;
  527.  ******************************************************************************/
  528.  
  529.  
  530. /******************************************************************************
  531.  * (XM_STRING_CONCAT <xmstring_a> <xmstring_b>)
  532.  *    --> returns a new XMSTRING  which is the concatenation of XMSTRINGS
  533.  *        <xmstring_a> and <xmstring_b>.
  534.  *
  535.  * XmString XmStringConcat (a, b)
  536.  *     XmString a;
  537.  *     XmString b;
  538.  ******************************************************************************/
  539. LVAL Wxms_Prim_XM_STRING_CONCAT()
  540. {
  541.   XmString xms_a = get_xmstring(xlga_xmstring());
  542.   XmString xms_b = get_xmstring(xlga_xmstring());
  543.   xllastarg();
  544.   return (cv_xmstring(XmStringConcat(xms_a, xms_b)));
  545. }
  546.  
  547.  
  548. /******************************************************************************
  549.  * I'm ignoring this one for now since it looks useless and low-level.
  550.  *
  551.  * XmString XmStringNConcat (a, b, n)
  552.  *     XmString a, b;
  553.  *     int n;
  554.  ******************************************************************************/
  555.  
  556.  
  557. /******************************************************************************
  558.  * (XM_STRING_COPY <xmstring>)
  559.  *    --> returns a new XMSTRING, a copy of <xmstring>
  560.  *
  561.  * XmString XmStringCopy (string)
  562.  *     XmString string;
  563.  ******************************************************************************/
  564. LVAL Wxms_Prim_XM_STRING_COPY()
  565. {
  566.   XmString xms = get_xmstring(xlga_xmstring());
  567.   xllastarg();
  568.   return (cv_xmstring(XmStringCopy(xms)));
  569. }
  570.  
  571.  
  572. /******************************************************************************
  573.  * I'm ignoring this one for now since it looks useless and low-level.
  574.  *
  575.  * XmString XmStringNCopy (a, n)
  576.  *     XmString a;
  577.  *     int n;
  578.  ******************************************************************************/
  579.  
  580.  
  581. /******************************************************************************
  582.  * (XM_STRING_BYTE_COMPARE <xmstring_a> <xmxtring_b>)
  583.  *    --> returns T if the two XMSTRING args are byte-for-byte equal, else
  584.  *        NIL.
  585.  *
  586.  * Note that this function will return NIL for an XMSTRING that is retrieved
  587.  * from a widget via :get_values, a callback, or a method. It's pretty useless, 
  588.  * just like all the other XmString bogosities.
  589.  *
  590.  * Boolean XmStringByteCompare (a, b)
  591.  *     XmString a, b;
  592.  ******************************************************************************/
  593. LVAL Wxms_Prim_XM_STRING_BYTE_COMPARE()
  594. {
  595.   extern LVAL true;
  596.   XmString xms_a = get_xmstring(xlga_xmstring());
  597.   XmString xms_b = get_xmstring(xlga_xmstring());
  598.   xllastarg();
  599.   return (XmStringByteCompare(xms_a, xms_b) ? true : NIL);
  600. }
  601.  
  602.  
  603. /******************************************************************************
  604.  * (XM_STRING_COMPARE <xmstring_a> <xmxtring_b>)
  605.  *    --> returns T if the two XMSTRING args are "semantically equal", 
  606.  *        else NIL.
  607.  *
  608.  * Boolean XmStringCompare (a, b)
  609.  *     XmString a, b;
  610.  ******************************************************************************/
  611. LVAL Wxms_Prim_XM_STRING_COMPARE()
  612. {
  613.   extern LVAL true;
  614.   XmString xms_a = get_xmstring(xlga_xmstring());
  615.   XmString xms_b = get_xmstring(xlga_xmstring());
  616.   xllastarg();
  617.   return (XmStringCompare(xms_a, xms_b) ? true : NIL);
  618. }
  619.  
  620.  
  621. /******************************************************************************
  622.  * (XM_STRING_LENGTH <xmstring>)
  623.  *    --> returns a FIXNUM representing the number of bytes in <xmstring>
  624.  *
  625.  * int XmStringLength (string)
  626.  *     XmString string;
  627.  ******************************************************************************/
  628. LVAL Wxms_Prim_XM_STRING_LENGTH()
  629. {
  630.   XmString xms = get_xmstring(xlga_xmstring());
  631.   xllastarg();
  632.   return (cvfixnum((FIXTYPE) XmStringLength(xms)));
  633. }
  634.  
  635.  
  636. /******************************************************************************
  637.  * (XM_STRING_EMPTY <xmstring>)
  638.  *    --> returns T if all segments in XMSTRING <xmstring> are zero length
  639.  *        or if there are no text segments. Otherwiser returns NIL.
  640.  *
  641.  * Boolean XmStringEmpty (string)
  642.  *     XmString string;
  643.  ******************************************************************************/
  644. LVAL Wxms_Prim_XM_STRING_EMPTY()
  645. {
  646.   extern LVAL true;
  647.   XmString xms = get_xmstring(xlga_xmstring());
  648.   xllastarg();
  649.   return (XmStringEmpty(xms) ? true : NIL);
  650. }
  651.  
  652. #ifdef WINTERP_MOTIF_11
  653. /******************************************************************************
  654.  * (XM_STRING_HAS_SUBSTRING <xmstring> <xmsubstring>)
  655.  *    --> returns T if <xmsubstring> is a substring of <xmstring>;
  656.  *        both argumetns are XmStrings. Otherwise, returns NIL.
  657.  *
  658.  * Boolean XmStringHasSubstring( XmString string , XmString substring );
  659.  *
  660.  ******************************************************************************/
  661. LVAL Wxms_Prim_XM_STRING_HAS_SUBSTRING()
  662. {
  663.   extern LVAL true;
  664.   XmString xmstring    = get_xmstring(xlga_xmstring());
  665.   XmString xmsubstring = get_xmstring(xlga_xmstring());
  666.   xllastarg();
  667.  
  668.   return (XmStringHasSubstring(xmstring, xmsubstring) ? true : NIL);
  669. }
  670. #endif                /* WINTERP_MOTIF_11 */
  671.  
  672.  
  673. /******************************************************************************
  674.  * Don't need to interface this -- XMSTRINGS are freed by garbage collector.
  675.  *
  676.  * void XmStringFree (string)
  677.  *     XmString string;
  678.  ******************************************************************************/
  679. /******************************************************************************
  680.  * Add this when I add the type XmFontList to winterp.
  681.  *
  682.  * Dimension XmStringBaseline (fontlist, string)
  683.  *     XmFontList fontlist;
  684.  *     XmString string;
  685.  ******************************************************************************/
  686. /******************************************************************************
  687.  * Add this when I add the type XmFontList to winterp.
  688.  *
  689.  * Dimension XmStringWidth (fontlist, string)
  690.  *     XmFontList fontlist;
  691.  *     XmString string;
  692.  ******************************************************************************/
  693. /******************************************************************************
  694.  * Add this when I add the type XmFontList to winterp.
  695.  *
  696.  * Dimension XmStringHeight (fontlist, string)
  697.  *     XmFontList fontlist;
  698.  *     XmString string;
  699.  ******************************************************************************/
  700. /******************************************************************************
  701.  * Add this when I add the type XmFontList to winterp.
  702.  *
  703.  * void XmStringExtent (fontlist, string, width, height)
  704.  *     XmFontList fontlist;
  705.  *     XmString string;
  706.  *     Dimension *width, *height;
  707.  ******************************************************************************/
  708.  
  709.  
  710. /******************************************************************************
  711.  * (XM_STRING_LINE_COUNT <xmstring>)
  712.  *    --> returns a FIXNUM representing the number of lines
  713.  *          in XMSTRING <xmstring>.
  714.  *
  715.  * int XmStringLineCount (string)
  716.  *     XmString string;
  717.  ******************************************************************************/
  718. LVAL Wxms_Prim_XM_STRING_LINE_COUNT()
  719. {
  720.   XmString xms = get_xmstring(xlga_xmstring());
  721.   xllastarg();
  722.   return (cvfixnum((FIXTYPE) XmStringLineCount(xms)));
  723. }
  724.  
  725.  
  726. /******************************************************************************
  727.  * Ignore -- too low-level.
  728.  
  729.  * void XmStringDraw (d, w, fontlist, string, gc, x, y, width, align, lay_dir, clip)
  730.  *     Display    *d;
  731.  *     Window     w;
  732.  *     XmFontList fontlist;
  733.  *     XmString    string;
  734.  *     GC        gc;
  735.  *     Position    x, y;
  736.  *     Dimension    width;
  737.  *     UChar    align;
  738.  *     UChar    lay_dir;
  739.  *     XRectangle    *clip;
  740.  ******************************************************************************/
  741. /******************************************************************************
  742.  * Ignore -- too low-level
  743.  * void XmStringDrawImage (d, w, fontlist, string, gc, x, y, 
  744.  *     width, align, lay_dir, clip)
  745.  *     Display    *d;
  746.  *     Window     w;
  747.  *     XmFontList fontlist;
  748.  *     XmString    string;
  749.  *     GC        gc;
  750.  *     Position    x, y;
  751.  *     Dimension    width;
  752.  *     UChar    align;
  753.  *     UChar    lay_dir;
  754.  *     XRectangle    *clip;
  755.  ******************************************************************************/
  756. /******************************************************************************
  757.  * Ignore -- too low-level
  758.  *
  759.  * void XmStringDrawUnderline (d, w, fontlist, string, gc, x, y, 
  760.  *     width, align, lay_dir, clip, underline)
  761.  *     Display    *d;
  762.  *     Window     w;
  763.  *     XmFontList fontlist;
  764.  *     XmString    string;
  765.  *     GC        gc;
  766.  *     Position    x, y;
  767.  *     Dimension    width;
  768.  *     UChar    align;
  769.  *     UChar    lay_dir;
  770.  *     XRectangle    *clip;
  771.  *     XmString    underline;
  772.  ******************************************************************************/
  773.  
  774.  
  775. #ifdef WINTERP_MOTIF_11
  776. /******************************************************************************
  777.  * (XM_CVT_CT_TO_XM_STRING  <STRING>)
  778.  *    --> returns an XMSTRING.
  779.  *
  780.  * "a compound string function that converts compound text to a compound string."
  781.  * <STRING> is a string...
  782.  *----------------------------------------------------------------------------
  783.  *           XmString XmCvtCTToXmString (text)
  784.  *                char        * text;
  785.  ******************************************************************************/
  786. LVAL Wxms_Prim_XM_CVT_CT_TO_XM_STRING()
  787. {
  788.   char* string = (char*) getstring(xlgastring());
  789.   xllastarg();
  790.   
  791.   return (cv_xmstring(XmCvtCTToXmString(string)));
  792. }
  793. #endif                /* WINTERP_MOTIF_11 */
  794.  
  795.  
  796. #ifdef WINTERP_MOTIF_11
  797. /******************************************************************************
  798.  * (XM_CVT_XM_STRING_TO_CT  <XMSTRING>)
  799.  *    --> returns a STRING.
  800.  *
  801.  * "a compound string function that converts a compound string to compound text."
  802.  * <XMSTRING> is an XMSTRING. 
  803.  *
  804.  *----------------------------------------------------------------------------
  805.  *           char * XmCvtXmStringToCT (string)
  806.  *                XmString    string;
  807.  ******************************************************************************/
  808. LVAL Wxms_Prim_XM_CVT_XM_STRING_TO_CT()
  809. {
  810.   XmString xmstring = get_xmstring(xlga_xmstring());
  811.   xllastarg();
  812.   
  813.   return (cv_string(XmCvtXmStringToCT(xmstring))); /* cv_string() doesn't copy string returned by XmCvtXmStringToCT()... the string will be freed by garbage collection when appropriate... */
  814. }
  815. #endif                /* WINTERP_MOTIF_11 */
  816.  
  817.  
  818. /*****************************************************************************
  819.  * Initialization proc.
  820.  ****************************************************************************/
  821. Wxms_Init()
  822. {
  823.   s_XmSTRING_DIRECTION_L_TO_R = xlenter(":STRING_DIRECTION_L_TO_R");
  824.   s_XmSTRING_DIRECTION_R_TO_L = xlenter(":STRING_DIRECTION_R_TO_L");
  825. }
  826.